COMMENT ⊗   VALID 00014 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE XM
C00003 00003	BEG:	SETOM LINE
C00007 00004	XINI:	SKIPN GO
C00010 00005		MOVE A,E	ROTATION
C00013 00006	XCHA:	SETZ 14,	↓↓MOVE UP AND RIGHT
C00018 00007	MVLFT:	MOVMS 0		MOVE LEFT THEN RIGHT
C00021 00008	OOBAR:	SETZM OOBFLG	 GET HERE IF ALL READY OOB
C00025 00009	FINDL:	HRRZ A,JOBREL		CK IF BIG ENUF
C00029 00010	INBITS:	PUSHJ P,NAMGET		INPUT OLD BIT FILE
C00031 00011	CORUP
C00033 00012	FRD:	MOVSI A,'PLT'		FILE SCAN
C00035 00013	GETNAM:	MOVEI A,		FILE SCAN
C00037 00014	FILNAM:	0			GLOPS OF JUNK
C00038 ENDMK
C⊗;
TITLE XM
	;↓↓AC DEF
A←1
B←2
C←3
D←4
E←5
L←6
U←7
X←11
Y←12
XD←13
T←15
TT←16
P←17
	
LPDL←←69
NBUFS←←4
DSK←←1
XGP←←2

LMAR←←=0
RMAR←←=1699
WIDTH←←=1700
LBUFL←←=48	;LINE LENGTH IN WORDS

LSTBIT←←1⊗34

OVERLAP←←=50

DOFF←←-=760

EXTERN JOBREL,JOBFF,JOBTPC,JOBAPR,JOBCNI
MAILBF:	BLOCK 40
SIGN:	0
LINE:	0
PNTR:	0
BEG:	SETOM LINE
	GETLIN LINE		;FOR ERROR PRINTOUT
	CALLI
	HRRZS LINE		;CLEAR LINE BITS
	HRRZI A,CORUP
	HRRZM A,JOBAPR
	SETOM SSS#
	HRRZ A,JOBFF		;RESET CORE WITHOUT A RESET
	CORE A,
	JRST 4,.

;FLUSHED BY REG  1-3-76
;	MOVE A,[IPC:20000 ↔ 0]
;	INTENB A,
;
;ADDED BY REG:
	MOVEI	A,20000		;REG  MPV
	APRENB	A,		;REG  ENABLE OLD WAY!

	MOVE P,[-LPDL,,PDL-1]
	OUTSTR [ASCIZ /OLD? /]
	SETZM GO#
	INCHWL E
	CAIE E,"L"		; L FOR LEGAL SIZE
	CAIN E,"l"
	JRST LEGLEG
	CAIE E,"G"		;IF 'G' SKIP ALL PROMPTS
	CAIN E,"g"
	CAIA
	JRST PASS
	PUSHJ P,FRD		;GO GET DEFAULT FILE NAME.
GOGO:	MOVEI =11		;DEFAULT PAGE LENGTH = 11" WITH 'G'
	JRST GOGOGO
LEGLEG:	PUSHJ P,FRD
LEGAL:	MOVEI =14		;TYPE 'L' FOR LEGAL SIZE 14"
GOGOGO:	MOVEM GO
;;;	SETOM GO		;FOR SKIPING ALL PROMPTS
;	INCHWL E
;	INCHWL E		 GET THE CRLF
	CLRBFI			;INSTEAD OF ↑↑
OUTSTR [ASCIZ/USING DEFAULT VALUES.
/]
	SETZM ROFLG#
	HRREI B,-60	;??
	JRST PASS2
PASS:	CAIE E,"Y"
	CAIN E,"y"
	JRST INBITS
	CLRBFI
FILIN:	OUTSTR [ASCIZ /FILE? (DEFAULT IS PLT.PLT) /]
	PUSHJ P,FRD
	SETZ A,
YAGN1:	HRREI B,-60
	SETZM ROFLG
OUTSTR [ASCIZ/ROTATE?/]		;YOU CAN TYPE 'G' FOR GO HERE TOO.
	INCHWL E
	CAIE E,"Y"
	CAIN E,"y"
	SETOM ROFLG
	CAIE E,"G"
	CAIN E,"g"
	JRST GOGO
	CAIE E,"L"
	CAIN E,"l"
	JRST LEGAL
	CLRBFI
OUTSTR [ASCIZ/ORIGIN X OFFSET FROM RIGHT (DEFAULT IS 4(CENTER))?/]
	PUSHJ P,RNUM
	JRST [	PASS2:	HRREI A,-=760 
			JRST YDEF]	;GET Y INFO
	IMULI A,=100
	CAIN C,"."		;DECIMAL POINT?
	JRST [	INCHWL C
		CAIN C,15
		INCHWL C
		CAIL C,"0"
		CAILE C,"9"
		JRST .+1
		SUBI C,60
		IMULI C,=10
		SKIPE SIGN
		MOVN C,C
		ADD A,C
		PUSH P,A
		PUSHJ P,RNUM
		JFCL
		POP P,A
		JRST .+1]	;.+1??
	MOVN A,A
	LSH A,1			;*2 (MAKE IT STEPS)
YDEFP:	CAIE C,12
	JRST [	CLRBFI
		JRST YAGN1]
YDEF:	ADD A,B
	MOVNM A,INIX#
AGAIN:	MOVE A,[FILNAM,,LKENT]
	BLT A,LKENT+3
	OPEN DSK,[14↔'DSK   '↔IBUF]
	JRST 4,.
	INBUF DSK,NBUFS
	LOOKUP DSK,LKENT
	JRST FNF
ASKLEN:	SETZM POOBX#
	SETZM POOBY#
	PUSHJ P,XINI		;GET X INFO
;	JRST CORLUZ
	SETZM XX#
	SETZM YY#
	MOVEI C,3
	HRRZM C,PENN#
OUTER:	IN DSK,
	JRST PLOT
	STATO DSK,20000
	JRST 4,.
	RELEAS DSK,
IFN LSTBIT-1,<PUSHJ P,XFIX>
	JRST PCUT
XINI:	SKIPN GO
	OUTSTR [ASCIZ /TOTAL LENGTH IN INCHES (Y DIMENSION, DEFAULT = 11)?/]
	SETZM DEFA#
	SKIPE GO
	JRST PASSD
	PUSHJ P,RNUM
	SETOM DEFA		;ASSUME 11 INCHES
	JUMPLE A,[XINLER:CLRBFI
		JRST XINI]
	SKIPGE DEFA		;? GO?
PASSD:	HRRZI A,=11
	SKIPE GO
	MOVE A,GO
;;PASSD:	MOVE A,GO		;EITHER 11 OR 14
	CAIE C,12
	JRST XINLER
	IMULI A,=200
	PUSH P,A
YINI1:	SKIPE GO
	JRST PASS3
	SKIPL ROFLG
	OUTSTR [ASCIZ \ORIGIN Y OFFSET FROM BOTTOM, 200/IN.(DEFAULT IS 100)?\]
	SKIPGE ROFLG
	OUTSTR [ASCIZ \ORIGIN Y OFFSET FROM BOTTOM, 200/IN.(DEFAULT IS 1000)?\]
	PUSHJ P,RNUM
PASS3:	JRST [	MOVEI A,=100
		SKIPGE ROFLG
		MOVEI A,=1000
		JRST IYDEF]
	CAIE C,12
	JRST [	CLRBFI
		JRST YINI1]
IYDEF:	IMULI A,LBUFL+1
	MOVEM A,IYPOS#
	POP P,A
XDEF:	MOVEM A,LINCNT#
	MOVEI B,-1(A)
	IMULI A,LBUFL+1		;A← BUFSIZ ← ROWS * COL
	MOVE T,JOBFF		;GET START ADDR
	MOVEM T,XGPPTR
	SOS XGPPTR
	MOVEI T,2(A)
	MOVNI TT,(T)
	ADD T,XGPPTR
	HRLM TT,XGPPTR		;XGPPTR← -WDCNT,,ADDR-1
	MOVE TT,T

	HRRZ L,XGPPTR
	MOVSI T,1(L)
	HRRI T,2(L)
 	SETZM 1(L)
 	MOVE U,JOBREL
 	BLT T,(U)		;ZERO TO END OF CORE
	HRRZI U,(TT)
	MOVEM B,SVBBB#
	
	MOVE Y,IYPOS
	ADDI Y,2(L)
	MOVEI XD,DBUF+1
	SKIPL A,INIX		;WHERE DO WE START
	JRST MAYBON
	SUBI A,43
	IDIV A,[-44]
	HRLOI X,XD
	SOJA A,SETB

MAYBON:	ADDI A,43
	IDIVI A,44
	CAILE A,LBUFL
	JRST OFFRT
	MOVE X,A
	SETZ A,
	HRLI X,Y
	JRST SETB

OFFRT:	MOVE X,[XD,,LBUFL]
	SUBI A,LBUFL
SETB:	MOVE B,INIX
	IDIVI B,44
	MOVSI B,400000
	MOVN C,C
	ROT B,(C)
	POPJ P,

POPJ1:	AOS (P)
CPOPJ:	POPJ P,
	MOVE A,E	;ROTATION
ROTA:	MOVE 14,2(A)
	LSHC 14,-10
	HLLZ C,15
	LSHC 14,-16
	HLLZ D,15
	LSHC 14,-16
	EXCH 15,D
	LSHC 14,16
	ASH D,-26
	MOVN 15,D
	LSH 15,26
	LSHC 14,16
	HLLZ 15,C
	LSHC 14,10
	MOVEM 14,2(A)
	AOBJN A,ROTA
	JRST PLOT1

SVX:	0
SVY:	0
SVPEN:	0

PLOT:	HRR C,IBUF+1
	MOVN E,1(C)	;FIX FOR NO WDCNT
	MOVSI E,(E)
	HRR E,IBUF+1
	SETZM XMOV#
	SETZM YMOV#
	SETZ 10,	; INIT SMEAR COUNTER
	SKIPGE ROFLG
	JRST ROTA-1
PLOT1:	MOVEM X,XXX
	MOVEM Y,YYY
      	MOVE XX
  	MOVEM SVXX#
  	MOVE YY
	MOVEM SVYY#
PLOT2:	MOVE 14,2(E)
	LSHC 14,-10
	ASH 15,-34
	MOVEM 15,SVPEN		;GET PEN CODE
	MOVM A,15
	LSHC 14,-16
	ASH 15,-26
;	ADD 15,YMOV		;FOR THICKENING
	MOVEM 15,SVY		;GET Y
	SUB 15,YY
	MOVEM 15,SVYSB#		;SAVE Y DIFF
	IMULI 15,LBUFL+1
	ADD 15,Y
	MOVEM 15,SVYOD#		;SAVE NEW Y
	CAIGE 15,(L)		;OFF TOP
	JRST LOSE
	CAIL 15,-LBUFL-1(U)	;OFF BOTTOM
	JRST LOSE
	LSHC 14,-16
	ASH 15,-26
;	ADD 15,XMOV		;FOR THICKENING
	MOVEM 15,SVX		;GET X
	SUB 15,XX
	MOVE 0,15		;0 HAS X DIFF
	HRRZ 16,X
	IMULI 16,44	;TIMES BITS INA WORD
	JFFO B,.+1	
	ADD 16,C	;PLUS REMAINDER EQ OLD X
	SUB 16,15
	JUMPL 16,LOSEX
	CAILE 16,=1727
	JRST LOSEX
	SKIPE OOBFLG#		;CK IF ALREADY OOB
	JRST OOBAR
FIXUP:	CAIE A,1	;FIXUP WHAT?
	HRRM A,PENN
	HRR A,PENN	;SAME PEN IF 1
	CAIN A,3
	JRST PENUP	;PENUP IF 3
	MOVE C,SVYSB	;Y DIFF
	IORM B,@X	;MARK NOW X Y
			;FIND DIRECTION
	JUMPE NORMX	;VERT OR NO MOVE
	JUMPL MVLFT	;LEFT
	JUMPE C,NRT	;HORZ
	JUMPL C,MVDWN	;DOWN
	CAMLE C,0	;JUMP IF Y DIFF > X DIFF
	JRST XCHA

	SETZ 14,	;↓↓ MOVE UP AND RIGHT
	TLNE C,200000
	JRST .+4
	LSH C,1
	TRO C,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV C,0
	MOVNS 14
	LSH C,(14)
	SETZ 15,
INLOOP:	ADD 15,C
	TLZE 15,200000
	ADDI Y,LBUFL+1
	SKIPGE B
	SOJ X,
	ROT B,1
	IORM B,@X
	SOJG INLOOP
	JRST DONXT
XCHA:	SETZ 14,	;↓↓MOVE UP AND RIGHT
	TLNE 0,200000
	JRST .+4
	LSH 0,1
	TRO 0,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV 0,C
	MOVNS 14
	LSH 0,(14)
	SETZ 15,
INLOO:	ADD 15,0
	TLZN 15,200000
	JRST MVUP
	SKIPGE B
	SOJ X,
	ROT B,1
MVUP:	ADDI Y,LBUFL+1
	IORM B,@X
	SOJG C,INLOO
	JRST DONXT

MVDWN:	MOVMS C		;↓↓MOVE DOWN AND RIGHT
	CAMLE C,0
	JRST XCHA2	;JUMP IF YDIFF > XDIFF
	SETZ 14,
	TLNE C,200000
	JRST .+4
	LSH C,1
	TRO C,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV C,0
	MOVNS 14
	LSH C,(14)
	SETZ 15,
INLOP:	ADD 15,C
	TLZE 15,200000
	SUBI Y,LBUFL+1
	SKIPGE B
	SOJ X,
	ROT B,1
	IORM B,@X
	SOJG INLOP
	JRST DONXT

XCHA2:	SETZ 14,	;↓↓MOVE DOWN AND RIGHT
	TLNE 0,200000
	JRST .+4
	LSH 0,1
	TRO 0,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV 0,C
	MOVNS 14
	LSH 0,(14)
	SETZ 15,
INOOP:	ADD 15,0
	TLZN 15,200000
	JRST MVEX
	SKIPGE B
	SOJ X,
	ROT B,1
MVEX:	SUBI Y,LBUFL+1
	IORM B,@X
	SOJG C,INOOP
	JRST DONXT

NRT:	JUMPL B,GOOP	;HORZ RIGHT
TOOT:	ROT B,1
	IORM B,@X
	SOJG 0,NRT
	JRST DONXT
GOOP:	SOJ X,
	CAIGE 0,44
	JRST TOOT
	IDIVI 0,44
	SETOM @X
	SOJ X,
	SOJG 0,.-2
	HRR 0,1
	JUMPN 0,TOOT
	AOJ X,
	JRST DONXT

NLFT:	MOVMS 0		;HORZ LEFT
	ROT B,-1
	JUMPL B,ROOT
WOOP:	IORM B,@X
	SOJG 0,.-3
	JRST DONXT
ROOT:	AOJ X,
	CAIGE 0,44
	JRST WOOP
	IDIVI 0,44
	SETOM @X
	AOJ X,
	SOJG 0,.-2
	HRR 0,1
	JUMPN 0,WOOP
	SOJ X,
	ROT B,1
	JRST DONXT
NORMX:	JUMPE C,NOMOVE	;NO DIFF
	JUMPL C,MDOWN	;MOVE VERT DOWN
MUP:	ADDI Y,LBUFL+1	;MOVE VERT UP
	IORM B,@X
	SOJG C,MUP
	JRST DONXT
MDOWN:	SUBI Y,LBUFL+1	;MOVE VERT DOWN
	IORM B,@X
	AOJL C,MDOWN
DONXT:	MOVE 4,SVX	;DONE. NOW UPDATE X AND Y
	MOVEM 4,XX
NXTY:	MOVE 4,SVY
	MOVEM 4,YY
NOMOVE:	SKIPL SVPEN
	JRST ENOUT
	SETZM XX	;IF NEW LOCO
	SETZM YY
ENOUT:	MOVEI 2
	CAME SVPEN
	JRST EN2
	SOJGE 10,SMEAR
;	JUMPE 10,EN3
;	MOVEI 10,5	;SET UP COUNTER FOR SMEAR (4)
  	MOVEI 10,4	;SET UP COUNTER FOR SMEAR (4)
  	JRST EN2

SMEAR:	MOVE SVXX
	MOVEM XX
	MOVE SVYY
	MOVEM YY
	JRST QQQ

	CAIN 10,5
	JRST LEFT
	CAIN 10,4
	JRST RIGHT
	CAIN 10,3
	JRST UP
	CAIN 10,2
	JRST DOWN
	SETZ 10,
	JRST EN3
DOWN:	SOS YMOV
	SOS YMOV
	SOS YY
	SOS YY
	JRST PLOT2
LEFT:	SOS XMOV
	SOS XX
	JRST PLOT2
RIGHT:	AOS XMOV
	AOS XMOV
	AOS XX
	AOS XX
	JRST PLOT2
UP:	AOS YMOV
	AOS YY
	JRST LEFT 

QQQ:	JUMPE 10,SM4	; ↓
 	CAIN 10,3	; ←
 	JRST SM1
 	CAIN 10,2	; ↑
 	JRST SM2
SM3:	SOS SVY   	; →
 	SOS YY  
 	JRST SM2+2
SM4:	SOS SVY
	SOS YY
SM1:	SOS SVX
	SOS XX
;;PAC:	0		;CALL PAC(PW,AR)
 	MOVEI 14,SVX	; ******* USES AC'S 4,5,6 ********
 	ADDI 14,2
 	HRR 15,@14	
 	LSHC 15,-10	;PEN
 	SOJ 14,
 	HRR 15,@14
 	LSHC 15,-16	;Y
 	SOJ 14,
 	HRR 15,@14	
 	LSHC 15,-16	;X
 	MOVE 14,16
;;	MOVEM 16,2(E)  
 	MOVE X,XXX#
 	MOVE Y,YYY#
 	JRST PLOT1+2
SM2:	AOS SVY
	AOS YY
	AOS SVX
	AOS XX
	JRST SM1+1

;EN3:	SETZM YMOV
EN2:	AOBJN E,PLOT1	;GET NEXT
	JRST OUTER
MVLFT:	MOVMS 0		;MOVE LEFT THEN RIGHT
	MOVMS 15
	JUMPE C,NLFT
	HRR Y,SVYOD
	IDIVI 15,44
	ADD X,15
XEND:	SOJL 16,DUN
	ROT B,-1
	JUMPGE B,XEND
	AOJ X,
	JRST XEND
DUN:	MOVEM X,XX	;SAVE NEW X POS
	MOVEM B,YY
	IORM B,@X
	JUMPL C,MVLD
	CAMLE C,0
	JRST XCHA3
	SETZ 14,	;MOVE LEFT UP
	TLNE C,200000
	JRST .+4
	LSH C,1
	TRO C,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV C,0
	MOVNS 14
	LSH C,(14)
	SETZ 15,
ILOOP:	ADD 15,C
	TLZE 15,200000
	SUBI Y,LBUFL+1
	SKIPGE B
	SOJ X,
	ROT B,1
	IORM B,@X
	SOJG ILOOP
	JRST BFOR

XCHA3:	SETZ 14,
	TLNE 0,200000
	JRST .+4
	LSH 0,1
	TRO 0,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV 0,C
	MOVNS 14
	LSH 0,(14)
	SETZ 15,
ILOP:	ADD 15,0
	TLZN 15,200000
	JRST DOQ
	SKIPGE B
	SOJ X,
	ROT B,1
DOQ:	SUBI Y,LBUFL+1
	IORM B,@X
	SOJG C,ILOP
	JRST BFOR

MVLD:	MOVMS C		;MOVE LEFT DOWN
	CAMLE C,0
	JRST XCHA4
	SETZ 14,
	TLNE C,200000
	JRST .+4
	LSH C,1
	TRO C,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV C,0
	MOVNS 14
	LSH C,(14)
	SETZ 15,
LOOP:	ADD 15,C
	TLZE 15,200000
	ADDI Y,LBUFL+1
	SKIPGE B
	SOJ X,
	ROT B,1
	IORM B,@X
	SOJG LOOP
	JRST BFOR

XCHA4:	SETZ 14,
	TLNE 0,200000
	JRST .+4
	LSH 0,1
	TRO 0,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV 0,C
	MOVNS 14
	LSH 0,(14)
	SETZ 15,
LOP:	ADD 15,0
	TLZN 15,200000
	JRST DOP
	SKIPGE B
	SOJ X,
	ROT B,1
DOP:	ADDI Y,LBUFL+1
	IORM B,@X
	SOJG C,LOP

BFOR:	HRR Y,SVYOD	;RESTORE PEN TO NEW PEN
	MOVE X,XX
	MOVE B,YY
	JRST DONXT
OOBAR:	SETZM OOBFLG	; GET HERE IF ALL READY OOB
	AOSG SSS	; THIS IS FOR THE FIRST OOB FROM MP
	JRST FIXUP	;
PENUP:	HRR Y,SVYOD	; PEN IS UP GET NEW Y
	JUMPE 15,NXTY	;IF VERT
	JUMPL 15,PULFT	;IF LEFT
	CAIGE 15,44	;↓↓MOVE UP PEN RIGHT TO NEW X
	JRST XLOOP
	IDIVI 15,44
	SUB X,15
	HRR 15,16
XLOOP:	SOJL 15,DONXT
	SKIPGE B
	SOJ X,
	ROT B,1
	JRST XLOOP

PULFT:	MOVMS 15	;↓↓MOVE UP PEN LEFT TO NEW X
	CAIGE 15,44
	JRST OOO
	IDIVI 15,44
	ADD X,15
	HRR 15,16
OOO:	SOJL 15,DONXT
	ROT B,-1
	JUMPGE B,OOO
	AOJ X,
	JRST OOO

LOSEX:	SETOM OOBFLG	;OOB X
	SKIPE POOBX
	JRST PENUP
	SETOM POOBX
	PUSHJ P,DETCHK
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ /POINT OUT OF BOUNDS, /
	JUMPL 16,[PUSHJ P,ERRPNT
		  ASCIZ/-X/
		  JRST PENUP]
	PUSHJ P,ERRPNT
	ASCIZ/+X/
	JRST PENUP

LOSE:	SETOM OOBFLG	;OOB Y
	SKIPE POOBY
	JRST LOBAC
	SETOM POOBY
	PUSHJ P,DETCHK
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ /POINT OUT OF BOUNDS, /
	CAIGE 15,(L)
	JRST [	PUSHJ P,ERRPNT
		ASCIZ/-Y/
		JRST LOBAC]
	PUSHJ P,ERRPNT
	ASCIZ/+Y/
LOBAC:	LSHC 14,-16
	ASH 15,-26
	MOVEM 15,SVX
	SUB 15,XX
	JRST PENUP

DECOUT:	IDIVI T,=10	;DEC TTY OUT
	HRLM TT,(P)
	SKIPE T
	PUSHJ P,DECOUT
	HLRZ TT,(P)
	ADDI TT,60
	ROT TT,-7
	MOVEM TT,.+2
	PUSHJ P,ERRPNT
	0
	POPJ P,

ERRPNT:	HRRZ TT,(P)		;ERROR TTY OUT
	MOVEM TT,PNTR
	MOVEI TT,LINE
	TTYMES TT,
	JRST [	OUTSTR[ASCIZ/TTYMES FAILED	/]
		OUTSTR @PNTR
		OUTSTR[ASCIZ/
/]
		JRST .+1]
	POP P,TT
	HRL TT,(TT)
	TLNE TT,376
	AOJA TT,.-2
	JRST 1(TT)

XERR:	PUSHJ P,ERRPNT		;DET TTY OUT
	ASCIZ/
MESSAGE FROM X WORKING ON /
	MOVE TT,FILNAM
	PUSHJ P,SIXOUT
	PUSHJ P,ERRPNT
	ASCIZ/./
	HLLZ TT,FILEXT
	PUSHJ P,SIXOUT
	PUSHJ P,ERRPNT
	ASCIZ/[/
	MOVE TT,FILPPN
	PUSHJ P,SIXOUT
	PUSHJ P,ERRPNT
	ASCIZ/] : /
	POPJ P,

SIXOUT:	JUMPE TT,CPOPJ		;SIXBIT OUT
	SETZ T,
	LSHC T,6
	ADDI T,40
	PUSH P,TT
	ROT T,-7
	MOVEM T,.+2
	PUSHJ P,ERRPNT
	0
	POP P,TT
	JRST SIXOUT

DETCHK:	SETOM DET#	;CK FOR DET JOB
	GETLIN DET
	HRRES DET
	SKIPL DET
	AOS (P)
	POPJ P,
FINDL:	HRRZ A,JOBREL		;CK IF BIG ENUF
	CAIL A,-LBUFL-1(U)
	JRST XINL-1
XL2:	MOVEM TT,(T)		;ADD MORE AND MARK
	ADDI T,LBUFL+1
	CAIGE T,(A)
	JRST XL2
	SUBI A,(L)
	MOVNS A
	HRLM A,XGPPTR
	SUBI T,LBUFL+1
	JRST XXOUT

PCUT:	HRRZ L,XGPPTR				;MARK BLOCK FOR XGP
	MOVE TT,[BYTE (12)4001,LMAR,LBUFL]
	MOVEM TT,1(L)		;FIRST ONE HAS MARK AND CUT WITH IT
	TLZ TT,400000		;DELETE MARK AND CUT
	MOVEI T,1+LBUFL+1(L)
	SKIPGE DEFA
	JRST FINDL
	MOVE B,SVBBB
XINL:	MOVEM TT,(T)
	ADDI T,LBUFL+1
	SOJG B,XINL
	HLRO TT,XGPPTR
	MOVNS TT
	ADDI TT,(L)
	MOVE A,(TT)
XXOUT:	MOVSI TT,400100
	MOVEM TT,(T)		;SO DOES LAST

XGPOUT:	OPEN XGP,XNIT		;XGP OUTPUT
;;;	PUSHJ P,NOXGP
	JRST NOXGP
	OUTSTR[ASCIZ/CRANKING XGP
/]
	LOCK
OUTIT:	OUT XGP,XGPPTR
	JRST OUTOK
DSKERR:	PUSHJ P,DETCHK
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ /XGP OUTPUT ERROR.
/
OUTOK:	UNLOCK
	RELEAS XGP,
XMORE:	PUSHJ P,DETCHK
;;	JRST DODEL			;DELETE AUTOMATICALLY IF DETACHED
	JFCL
	OUTSTR[ASCIZ/D=DELETE, R=REPEAT, X=EXIT  /]
	INCHRW C
	CAIE C,15
	JRST .+3
	INCHRW C
	JRST XMORE+2			; WON'T ACCEPT JUST CRLF
	OUTSTR[ASCIZ/
/]
	CAIE C,"X"
	CAIN C,"x"
	SKIPA
	JRST .+3
	PUSHJ P,CORDWN			;REALLY DONE, CORE DOWN
	JRST NODEL 
	CAIE C,"R"
	CAIN C,"r"
	JRST XGPOUT
	CAIE C,"D"
	CAIN C,"d"
	SKIPA   			;IF NOT R, X OR D TRY AGAIN.
	JRST XMORE+2
	PUSHJ P,CORDWN			;REALLY DONE, CORE DOWN
DODEL:	MOVE A,[FILNAM,,LKENT]
	BLT A,LKENT+3
	INIT DSK,17
	'DSK   '
	0
	JRST [	SKIPGE DET
		PUSHJ P,XERR
		PUSHJ P,ERRPNT
		ASCIZ/COULDN'T GET DISK FOR DELETE!
/
		JRST NODEL]
	LOOKUP DSK,LKENT
	JRST [	SKIPGE DET
		PUSHJ P,XERR
		PUSHJ P,ERRPNT
		ASCIZ/LOOKUP FOR DELETE FAILED!
/
		JRST NODEL]
	MOVE A,FILPPN
	MOVEM A,LKENT+3
	SETZM LKENT
	RENAME DSK,LKENT
	CAIA
	JRST NODEL
	SKIPGE DET
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ/RENAME FOR DELETE FAILED!
/
NODEL:	RELEASE DSK,
	SKIPGE DET
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ/ALL DONE!
/
	CALLI 12		;LEAVE

NOXGP:	PUSHJ P,DETCHK
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ /
XGP BUSY, OUTPUT TO DISK? /
	INCHRW A
	CAIE A,"Y"
	CAIN A,"y"
	JRST OUTFIL
	HRRZI A,1017
	HRRZM A,XNIT
;;;	POPJ P,
	JRST XGPOUT

XNIT:	417
	'XGP   '
	0
XGPPTR:	BLOCK 2

IFN LSTBIT-1,<
XFIX:	MOVE A,[LSTBIT-1]
	HRRZ C,JOBREL
	HRRZ D,XGPPTR
XFIXL:	ANDCAM A,LBUFL-1+2(D)
	ADDI D,LBUFL+1
	CAIGE D,(C)
	JRST XFIXL
	POPJ P,
>
CORDWN:	MOVE T,JOBFF
	SUBI T,1
	CALLI T,11
	JRST 4,.
	POPJ P,
INBITS:	PUSHJ P,NAMGET		;INPUT OLD BIT FILE
	HRRZ U,JOBFF
	HRRZI T,177(U)
	CORE T,
	JRST INBITS
	SOJ U,
	HRLI U,-200
	OPEN [17↔'DSK   '↔0]
	JRST INBITS
	LOOKUP FILNAM
	JRST INBITS
	SETZ 10,
TRYTRY:	OPEN XGP,XNIT	  ;***** GRAB THE XGP BEFORE CORE EXPANSION
	JRST NONO    	 ;CAN'T GET IT!
	INPUT U
	MOVE T,[BYTE (12)4001,LMAR,LBUFL]
	EXCH T,1(U)
	HLL U,T
	MOVEM U,XGPPTR
	HRLI U,(T)
	TLNN U,777777
	JRST CLOZE
	ADDI U,200
	MOVNI T,(T)
	ADDI T,(U)
	CORE T,
	JRST INBITS	;HANG
	INPUT U
CLOZE:	RELEAS
	JRST XGPOUT

NONO:	OUTSTR[ASCIZ/
WAITING FOR XGP  /]
	HRRZI A,1017
	HRRZM A,XNIT
	JRST TRYTRY

OUTFIL:	PUSHJ P,NAMGET		;OUTPUT BIT FILE
	MOVE U,XGPPTR
	HLRO T,U
	MOVNS T
	TRZ T,177
	HRRZI A,200(T)
	ADDI A,(U)
	CORE A,
	JRST OUTFIL
	MOVNS T
	HLL T,U			;FIRST WD IS WC-200,-WC
	MOVEM T,1(U)
	HRLI U,-200(T)
	SETZ 10,
	OPEN [17↔'DSK   '↔0]
	JRST 4,.
	ENTER FILNAM
	CAIA
	OUTPUT U
	RELEAS
	JRST NODEL
;CORUP

CORUP:

REPEAT 0,<	OLD WAY - FLUSHED BY REG 1-3-76

	HRRZ B,JOBCNI
	CAIE B,20000
	DISMIS
	MOVE A,JOBTPC
	MOVEM A,IPC+1
	UWAIT
	DEBREAK
>;END REPEAT 0

BUST:	MOVEM	1,SVONE#
 	MOVEM	2,SVTWO#
	MOVEM	TT,SVTTT#
	MOVE	1,JOBCNI	;REG  GET APR CONI BITS
	TRNN	1,20000		;REG  IS THERE AN MPV?
	JRST	NOMPV		;REG  NO
	HRRZ	1,JOBREL	;OLD CORE SIZE
	MOVSI	2,1(1)		;FIRST NEW WORD WE'LL GET
	HRRI	2,2(1)		;SECOND NEW WORD  - 2 HAS A BLT POINTER.
	ADDI	1,16000
;;	ADDI	1,10000		;GET ANOTHER 8K
	MOVE	TT,1
	CORE	1,
	PUSHJ	P,CORLUZ
	HRRZ	1,JOBREL
	SETZM	-1(2)
 	BLT	2,(1)		;ZERO NEW CORE
	MOVE	1,SVONE
 	MOVE	2,SVTWO
	MOVE	TT,SVTTT

REPEAT 0,<
	INTJEN IPC
>

	JRST	2,@JOBTPC	;REG  THIS IS HOW TO DISMISS OLD INTERRUPT

NOMPV:	OUTSTR	[ASCIZ/UNEXPECTED INTERRUPT?
/]
	JRST	2,@JOBTPC

CORLUZ:	MOVE T,TT
	LSH T,-12
	PUSH P,T
	PUSHJ P,DETCHK
	PUSHJ P,XERR
	POP P,T
	PUSHJ P,DECOUT
	PUSHJ P,ERRPNT
	ASCIZ / K OF CORE NEEDED!
/
	SKIPGE DET
	CALLI 12
	JRST ASKLEN

FNF:	PUSHJ P,DETCHK		;FILE NOT FOUND
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ /LOOKUP FAILED.
/
	SKIPGE DET
	CALLI 12
	JRST FILIN
FRD:	MOVSI A,'PLT'		;FILE SCAN
	MOVEM A,FILEXT
	SKIPN GO
	JRST .+3		;GO?
	MOVEI C,12		; CR
	JRST .+3
	PUSHJ P,GETNAM
	SKIPN A
 	MOVE A,['PLT   ']
    	MOVEM A,FILNAM
	CAIE C,"."
	JRST NOEXT
	PUSHJ P,GETNAM
	MOVEM A,FILEXT
NOEXT:	CAIE C,"["
	JRST FRDX
	PUSHJ P,GETP
	HRLZM A,FILPPN
	PUSHJ P,GETP
	HRRM A,FILPPN
FRDX:	SKIPN GO
	INCHRW C
	CAIE C,12
	JRST FRDX
	POPJ P,

RNUM:	INCHWL C		;NUM SCAN
	CAIN C,15
	JRST RNUM
	CAIN C,12
	POPJ P,
	AOS (P)
	MOVEI A,
	SETZM SIGN
	CAIN C,"-"
	JRST [	PUSHJ P,RNUML
		SETOM SIGN
		MOVN A,A
		POPJ P,]
	CAIN C,"+"
RNUML:	INCHWL C
	CAIL C,"0"
	CAILE C,"9"
	JRST RNUMX
	IMULI A,12
	ADDI A,-"0"(C)
	JRST RNUML

RNUMX:	CAIN C,15
	INCHRW C
	POPJ P,
GETNAM:	MOVEI A,		;FILE SCAN
	MOVE B,[440600,,A]
GETNML:	PUSHJ P,RCH
	POPJ P,
	SUBI C,40
	TLNE B,770000
	IDPB C,B
	JRST GETNML

GETP:	MOVEI A,
GETPL:	PUSHJ P,RCH
	POPJ P,
	TRNE A,770000
	JRST GETPL
	LSH A,6
	ADDI A,-40(C)
	JRST GETPL

RCH:	INCHWL C
	CAIN C,42
	JRST RCHQ
	CAIE C,11
	CAIN C," "
	JRST RCH
	CAIE C,"."
	CAIN C,","
	POPJ P,
	CAIE C,"["
	CAIN C,"]"
	POPJ P,
RCHQR:	CAIGE C,40
	POPJ P,
	CAIL C,"a"
	CAILE C,"z"
	CAIA
	SUBI C,40
	JRST POPJ1

RCHQ:	INCHWL C
	JRST RCHQR

NAMGET:	CLRBFI
	OUTSTR [ASCIZ/
	FILE = /]
	SETZM FILEXT+1
	SETZM FILPPN
	MOVSI A,'BIT'
	MOVEM A,FILEXT
	PUSHJ P,GETNAM
	SKIPN A
 	MOVE A,['PLT   ']
    	MOVEM A,FILNAM
	CAIE C,"."
	JRST NOEXTN
	PUSHJ P,GETNAM
	MOVEM A,FILEXT
NOEXTN:	CAIE C,"["
	JRST FFDX
	PUSHJ P,GETP
	HRLZM A,FILPPN
	PUSHJ P,GETP
	HRRM A,FILPPN
FFDX:	INCHRW C
	CAIE C,12
	JRST FFDX
	POPJ P,
FILNAM:	0			;GLOPS OF JUNK
FILEXT:	0
	0
FILPPN:	0

LKENT:	BLOCK 4

XGSNAM:	0
XGSEXT:	0
	0
XGSPPN:	0

IBUF:	BLOCK 3

BITTAB:	FOR I←43,0,-1{1⊗I
}
BYTTAB:	FOR I←36,0,-6{REPEAT 6,{77⊗I}}

DBUF:	BLOCK LBUFL+2

PDL:	BLOCK LPDL

END BEG